home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / comm / bbs / WWBBSDoors.lha / WWBBS / rexxDoors / Yacht_C.rexx < prev    next >
OS/2 REXX Batch file  |  1995-04-27  |  33KB  |  1,291 lines
  1. /* Yacht-C.rexx version 1.1 by Matt English 8-4-93
  2.  
  3.    This game was written to work on Richard Stockton's
  4.    BBBBS program. You are welcome to use this on your
  5.    BBBBS system as long as my name is not removed from
  6.    this code, or the game screen.
  7.  
  8.    CONVERSIONS : !!!!!!!!
  9.    You are given permission to convert this game to ANY
  10.    other BBS system, Amiga or IBM, as long as:
  11.  
  12.    1. You leave my name in the code and on the game screen.
  13.    2. You have never written a game that says "ONLY TO BE
  14.       USED ON xxxxx BBS SYSTEM". ( I really, really hate that!)
  15.  
  16.    TO ALL SYSOPS:
  17.     If you use this game, a call to my BBS would be nice!
  18.     (If you've never called.) I have more ideas for the game,
  19.     and if I get enough interest there will be a "next version".
  20.  
  21.     The Alternative BBS (503) 761-3043
  22.  
  23.  
  24.     TO INSTALL ON BBBBS:
  25.      All ya have to do is copy the file "Yacht_C.rexx"
  26.      to your RexxDoors directory. The game will create
  27.      some data files after its played. Easy, Huh?
  28.  
  29.     Enjoy.
  30.  */
  31.  
  32. options results
  33. FF='0C'x  /* FormFeed */
  34. CR='0D'x  /* Carraige Return */
  35. CALL TIME('R')
  36. SIGNAL ON BREAK_C
  37. SIGNAL ON BREAK_E
  38.  
  39. bbspath='wwbbs:'
  40. bbspath=bbspath'rexxDoors/Data/'
  41. datapath = bbspath'Yacht_C'
  42.  
  43. /* Open the support library if it is not already open. */
  44. if ~show('L',"rexxsupport.library") then do
  45.     addlib('rexxsupport.library',0,-30,0)
  46.      end
  47.  
  48. wz = random(1,999,time('S')) /* initalize random number generator */
  49.  
  50. PARSE arg name winnings . colorflag secs .
  51.  
  52. BBSIDENTIFY EMULATION
  53. PARSE VAR RESULT type .
  54. if type = "ANSI" then
  55.   colorflag=1
  56. else
  57.   colorflag=0
  58.  
  59. BBSIDENTIFY USER
  60. PARSE VAR RESULT Username From Acces .
  61. name = substr(Username,2,length(Username)-2)
  62.  
  63. IF secs='' THEN secs=3600
  64. signal on syntax
  65. player = left(name,20)
  66.  
  67. address command'C:resident C:sort add'
  68.  
  69. def=''
  70. CLS = 'H'
  71. UNL = ''
  72.  
  73. call Prefs(1)
  74. IF ADDRESS()~='BAUD' THEN call Prefs(5)
  75.  
  76. player = pen.6||unl||player||def
  77.  
  78.  
  79. /* Positions */
  80.  pplayer='H';ps.1='8H';ps.2='8H';ps.3='8H';ps.4='8H';ps.5='8H'
  81.  ps.6='8H';psub='8H';pbon='28H';putot='28H';ps.3k='28H'
  82.  ps.4k='28H';ps.fh='28H';ps.ss='28H';ps.ls='28H'
  83.  ps.c='28H';ps.y='28H';pltot='28H';putot2='28H';ptot='28H'
  84.  
  85.  pln.1='H';pln.2='H';pln.3='H';pln.4='H';pln.5='H';pln.6='H';pln.3k='1H'
  86.  pln.4k='1H';pln.fh='1H';pln.ss='1H';pln.ls='1H'
  87.  pln.c='1H';pln.y='1H'
  88.  
  89.  phold.1='5H';phold.2='1H';phold.3='7H';phold.4='3H';phold.5='9H'
  90.  prollsleft='38H'
  91.  pprompt='34H'
  92.  pprompt1='34H'
  93.  pprompt2='34H'
  94.  
  95.  pd.1.1='5H';pd.1.2='6H';pd.1.3='7H';pd.1.4='5H';pd.1.5='6H';pd.1.6='7H';pd.1.7='5H';pd.1.8='6H';pd.1.9='7H'
  96.  pd.2.1='1H';pd.2.2='2H';pd.2.3='3H';pd.2.4='1H';pd.2.5='2H';pd.2.6='3H';pd.2.7='1H';pd.2.8='2H';pd.2.9='3H'
  97.  pd.3.1='7H';pd.3.2='8H';pd.3.3='9H';pd.3.4='7H';pd.3.5='8H';pd.3.6='9H';pd.3.7='7H';pd.3.8='8H';pd.3.9='9H'
  98.  pd.4.1='3H';pd.4.2='4H';pd.4.3='5H';pd.4.4='3H';pd.4.5='4H';pd.4.6='5H';pd.4.7='3H';pd.4.8='4H';pd.4.9='5H'
  99.  pd.5.1='9H';pd.5.2='0H';pd.5.3='1H';pd.5.4='9H';pd.5.5='0H';pd.5.6='1H';pd.5.7='9H';pd.5.8='0H';pd.5.9='1H'
  100.  
  101.  poptln='34H'
  102.  
  103.  optstr = 'H Q P SC 1 2 3 4 5 6 3K 4K FH SS LS C Y'
  104.  sstr = '1 2 3 4 5 6 3K 4K FH SS LS C Y' /* Scoreable string */
  105.  
  106. call setlines
  107.  
  108. if ~exists(datapath) then do
  109.  call makedir(datapath)
  110.  tempname = name
  111.  name = 'MATT_ENGLISH'    /* Has to be one file to match Scorelist */
  112.  call zerovar
  113.  call savedata
  114.  name = tempname
  115.  end
  116. if exists(datapath'/'name) then call loaddata
  117. else do
  118.  call zerovar
  119.  say''CLS''cr
  120.  say cr
  121.  say cr
  122.  say' A NEW PLAYER !!! 'cr
  123.  say' Welcome to Yacht_C !!!'cr
  124.  call delay(100)
  125.  newplayer = 1 /* first time player */
  126.  end
  127.  
  128. call refresh1
  129. call refresh2
  130. call setlines
  131.  
  132. /*
  133. Loop:
  134.  do forever
  135.   spotsleft = spotsleft - 1
  136.   if spotsleft = 0 then call done
  137.   call getopt
  138.   end  */
  139.  
  140. call getopt
  141.  
  142. zerovar:                           /* Variable values at startup */
  143.  s.1 = '' /* Score for the 1's */
  144.  s.2 = '';s.3='';s.4='';s.5='';s.6=''
  145.  sub='0';bon='0';utot='0';utot2='0'
  146.  s.3k='';s.4k='';s.fh='';s.ss='';s.ls='';s.c='';s.y='';ltot='0';tot='0'
  147.  hold.1='    ';hold.2='    ';hold.3='    ';hold.4='    ';hold.5='    '
  148.  rollsleft='3'
  149.  spotsleft = 13
  150.  dvalue.1 = 1;dvalue.2=2;dvalue.3=3;dvalue.4=4;dvalue.5=5
  151.  do t = 1 to 6
  152.   x.t = random(1,10)
  153.   end
  154.  dcstring = x.1' d1 'x.2' d2 'x.3' d3 'x.4' d4 'x.5' d5 'x.6' d6'
  155.  rvalue = 0
  156.  newplayer = 0
  157. return
  158.  
  159.  
  160. setlines:
  161.  low = bak.0||pen.1
  162.  hi = bak.2||pen.1
  163.  ln.1=''pen.1' [ 1] ones      (add 1''s)'def''
  164.  ln.2=''pen.1' [ 2] twos      (add 2''s)'def''
  165.  ln.3=''pen.1' [ 3] threes    (add 3''s)'def''
  166.  ln.4=''pen.1' [ 4] fours     (add 4''s)'def''
  167.  ln.5=''pen.1' [ 5] fives     (add 5''s)'def''
  168.  ln.6=''pen.1' [ 6] 'unl'sixes     (add 6''s)'def''
  169.  ln.3k=''pen.1' [3K] 3 of a kind (total)'def''
  170.  ln.4k=''pen.1' [4K] 4 of a kind (total)'def''
  171.  ln.fh=''pen.1' [FH] Full House     (25)'def''
  172.  ln.ss=''pen.1' [SS] Small Straight (30)'def''
  173.  ln.ls=''pen.1' [LS] Large Straight (40)'def''
  174.  ln.c=''pen.1' [ C] Chance      (total)'def''
  175.  if s.y = '' then ln.y=''pen.1' [ Y] 'unl'Yacht-C        (50)'def''unl''pen.1' |   'def''
  176.  if s.y = '50' then ln.y=''pen.1' [ Y] 'unl'Yacht-C        (50)'def''unl''pen.1' |'def''unl' 50'def''
  177.  if s.y = ' --' then ln.y=''pen.1' [ Y] 'unl'Yacht-C        (50)'def''unl''pen.1' |'def''unl' --'def''
  178. return
  179.  
  180. Loaddata:
  181.  call open(data,datapath'/'name,'R')
  182.  lastplay = readln(data)
  183.  colorset = readln(data)
  184.  if colorset = '' then
  185.    DO
  186.      IF ADDRESS()='BAUD' THEN colorset=1
  187.      ELSE colorset=5
  188.    END
  189.  call prefs(colorset)
  190.  say''CLS''cr
  191.  say cr
  192.  say cr
  193.  say' Welcome back to Yacht_C!!'cr
  194.  say' You last played this game on 'lastplay''cr
  195.  say cr
  196.  call delay(100)
  197.  prompt(''pen.4' Would you like to continue your last game? (Y,n) > ')
  198.  continue=readstr()
  199.  if continue = 'N' then do
  200.   call close(data)
  201.   call zerovar
  202.   return
  203.   end
  204.  call zerovar
  205.  say cr
  206.  say' Loading data, stand by ...'cr
  207.  again = 1
  208.  rollsleft = readln(data)
  209.  spotsleft = readln(data)
  210.  if spotsleft = 0 then do
  211.   call zerovar
  212.   call close(data)
  213.   return
  214.   end
  215.  do i = 1 to words(sstr)
  216.   j = word(sstr,i)
  217.   s.j = readln(data)
  218.   end
  219.  sub = readln(data)
  220.  bon = readln(data)
  221.  utot = Readln(data)
  222.  utot2 = readln(data)
  223.  ltot = Readln(data)
  224.  tot = readln(data)
  225.  do i = 1 to 5
  226.   dvalue.i = readln(data)
  227.   end
  228.  call close(data)
  229.  call refresh1
  230.  call refresh2
  231.  call setlines
  232.  call showdice
  233.  call getopt
  234.  
  235. savedata:
  236.  if exists(datapath'/'name) then call delete(datapath'/'name)
  237.  call open(data,datapath'/'name,'W')
  238.  thedate = date()
  239.  call writeln(data,thedate)
  240.  if colorset = '' then colorset = 1
  241.  call writeln(data,colorset)
  242.  call writeln(data,rollsleft)
  243.  call writeln(data,spotsleft)
  244.  do i = 1 to words(sstr)
  245.   j = word(sstr,i)
  246.   call writeln(data,s.j)
  247.   end
  248.  call writeln(data,sub)
  249.  call writeln(data,bon)
  250.  call writeln(data,utot)
  251.  call writeln(data,utot2)
  252.  call writeln(data,ltot)
  253.  call writeln(data,tot)
  254.  do i = 1 to 5
  255.   call writeln(data,dvalue.i)
  256.   end
  257.  call close(data)
  258. return
  259.  
  260. clrl:
  261.  arg what
  262.  if what = 0 then where = pprompt
  263.  if what = 1 then where = pprompt1
  264.  if what = 2 then where = poptln
  265.  if what = 3 then where = pprompt2
  266.  if what = 2 then color = bak.6
  267.  else color = def
  268.  say''where''color'                              'def'  '
  269. return
  270.  
  271. getopt:
  272.  if spotsleft = 0 then call done
  273.  call setopt
  274.  say''prollsleft''rollsleft''
  275.  call clrl(0)
  276.  call clrl(1)
  277.  do s = 1 to 5
  278.   hold.s = '    '
  279.   say''phold.s''hold.s''
  280.   end
  281.  if rollsleft = 3 then line = 'Hit 'pen.3'Return'def' 'pen.1'to Roll the dice'def' > '
  282.  if rollsleft = 2 | rollsleft = 1 then line = '   'pen.1'Enter the Option to take or 'def''
  283.  if rollsleft = 0 then line = ''pen.1'Enter your Option'def' > '
  284.  if rollsleft = 2 | rollsleft = 1 then do
  285.   say''pprompt''line''
  286.   prompt(''pprompt1'       'pen.3'Return'def' 'pen.1'to Roll 'def'> ')
  287.   end
  288.  else prompt(''pprompt''line'')
  289.  opt=readstr()
  290.  opt = upper(strip(opt))
  291.  if rollsleft = 3 then do
  292.   select
  293.    when opt = H then call help
  294.    when opt = Q then call quit(1)
  295.    when opt = SC then call checkopt
  296.    when opt = P then do
  297.     call setPrefs
  298.     call getopt
  299.     end
  300.    otherwise call rolldice(12345)
  301.    end
  302.   end
  303.  if rollsleft = 2 | rollsleft = 1 then do
  304.   select
  305.    when opt = H then call help
  306.    when opt = Q then call quit(1)
  307.    when opt = P then do
  308.     call setPrefs
  309.     call getopt
  310.     end
  311.    when opt = '' then do
  312.     call holddice
  313.     call rolldice(pick)
  314.     end
  315.    otherwise call checkopt
  316.    end
  317.   end
  318.  if rollsleft = 0 then do
  319.   select
  320.    when opt = H then call help
  321.    when opt = Q then call quit(1)
  322.    when opt = P then do
  323.     call setPrefs
  324.     call getopt
  325.     end
  326.    when opt = '' then call getopt
  327.    otherwise call checkopt
  328.    end
  329.   end
  330. return
  331.  
  332. checkopt:
  333.  init = 0
  334.  if opt = SC then init = 1
  335.  if init = 0 then do i = 1 to words(optln)
  336.   testopt = word(optln,i)
  337.   if opt = testopt then init = 1
  338.   end
  339.  if init = 0 then do
  340.   call clrl(0)
  341.   call clrl(1)
  342.   say''pprompt''pen.2'INVALID Option!!'def''
  343.   call delay(100)
  344.   call getopt
  345.   end
  346.  if opt = 1 then s.1 = countin(dstring,'1')
  347.  if opt = 2 then s.2 = (countin(dstring,'2') * 2)
  348.  if opt = 3 then s.3 = (countin(dstring,'3') * 3)
  349.  if opt = 4 then s.4 = (countin(dstring,'4') * 4)
  350.  if opt = 5 then s.5 = (countin(dstring,'5') * 5)
  351.  if opt = 6 then s.6 = (countin(dstring,'6') * 6)
  352.  if opt = 3K then s.3K = dvalue.1 + dvalue.2 + dvalue.3 + dvalue.4 + dvalue.5
  353.  if opt = 4K then s.4K = dvalue.1 + dvalue.2 + dvalue.3 + dvalue.4 + dvalue.5
  354.  if opt = FH then s.FH = 25
  355.  if opt = SS then s.SS = 30
  356.  if opt = LS then s.LS = 40
  357.  if opt = C  then s.c = dvalue.1 + dvalue.2 + dvalue.3 + dvalue.4 + dvalue.5
  358.  if opt = Y  then s.Y = 50
  359.  if opt = SC then do
  360.   call clrl(0)
  361.   call clrl(1)
  362.   prompt(''pprompt'Which item to Scratch? > ')
  363.   scit=readstr()
  364.   itsok = 0
  365.   do i = 1 to words(sstr)
  366.    j = word(sstr,i)
  367.    if j = scit & s.j = '' then do
  368.     itsok = 1
  369.     call clrl(0)
  370.     prompt(''pprompt'Scratch 'scit'? (Y,n) > ')
  371.     thething=readstr()
  372.     if thething = 'N' then call getopt
  373.     s.scit = ' --'
  374.     end
  375.    end
  376.   if itsok = 0 then do
  377.    call clrl(0)
  378.    say''pprompt''pen.3'SAY WHAT?? Try again..'def''
  379.    call getopt
  380.    end
  381.   end
  382.  sub = 0
  383.  bon = 0
  384.  utot = 0
  385.  utot2 = 0
  386.  ltot = 0
  387.  tot = 0
  388.  do i = 1 to words(sstr)
  389.   thisscore = word(sstr,i)
  390.   if i < 7 then do
  391.    if s.thisscore = ' --' then do
  392.     s.thisscore = 0
  393.     scratch = 'YES'
  394.     end
  395.    if s.thisscore = '' then s.thisscore = 0
  396.    sub = sub + s.thisscore
  397.    if sub > 62 then bon = 35
  398.    utot = sub + bon
  399.    utot2 = utot
  400.    if s.thisscore = 0 then s.thisscore = ''
  401.    if scratch = 'YES' then do
  402.     s.thisscore = ' --'
  403.     scratch = 'NO'
  404.     end
  405.    end
  406.   if i > 6 then do
  407.    if s.thisscore = ' --' then do
  408.     s.thisscore = 0
  409.     scratch = 'YES'
  410.     end
  411.    if s.thisscore = '' then s.thisscore = 0
  412.    ltot = ltot + s.thisscore
  413.    tot = ltot + utot
  414.    if s.thisscore = 0 then s.thisscore = ''
  415.    if scratch = 'YES' then do
  416.     s.thisscore = ' --'
  417.     scratch = 'NO'
  418.     end
  419.    end
  420.   end
  421.  do i = 1 to words(sstr)
  422.   j = word(sstr,i)
  423.   if i = 6 | i = 'Y' then style = unl
  424.   else style = ''
  425.   nostyle = def
  426.   here = right(s.j,3)
  427.   say''ps.j''style''here''nostyle''
  428.   end
  429.  say''psub''right(sub,3)''
  430.  say''pbon''unl''right(bon,3)''def''
  431.  say''putot''right(utot,3)''
  432.  say''pltot''right(ltot,3)''
  433.  say''putot2''unl''right(utot2,3)''def''
  434.  say''ptot''right(tot,3)''
  435.  rollsleft = 3
  436.  spotsleft = spotsleft - 1
  437.  call getopt
  438.  
  439. /* call loop */
  440.  
  441.  
  442. sortstr:
  443.  call open(file,'ram:sortfile','W')
  444.  do i = 1 to 5
  445.   num = substr(dstring,i,1)
  446.   call writeln(file,num)
  447.   end
  448.  call close(file)
  449.  address command'sort Ram:sortfile ram:sorted'
  450.  call open(file,'ram:sorted','R')
  451.  az=readln(file)
  452.  bz=Readln(file)
  453.  cz=readln(file)
  454.  dz=readln(file)
  455.  ez=readln(file)
  456.  call close(file)
  457. return
  458.  
  459. setopt:               /* Hilight or Lowlight proper options */
  460.  dstring = dvalue.1||dvalue.2||dvalue.3||dvalue.4||dvalue.5
  461.  call sortstr
  462.  histr = ''
  463.  call clrl(2)
  464.  if rollsleft = 3 then do
  465.   call sethi(histr)
  466.   return
  467.   end
  468.  do l = 1 to 5              /* Chk for 1's thru 6's */
  469.   do m = 1 to 6
  470.    if dvalue.l = m & s.m = '' then do
  471.     if histr = '' then histr = m
  472.     else histr = histr||' 'm
  473.     end
  474.    end
  475.   end
  476.  temphi = ''
  477.  do i = 1 to 6
  478.   if instring(i,histr) then do
  479.    if temphi = '' then temphi = i
  480.    else temphi = temphi||' 'i
  481.    end
  482.   end
  483.  histr = temphi
  484.                /* Chk for 3K */
  485.  do l = 1 to 6
  486.   if countin(dstring,l) > 2 & s.3K = '' then do
  487.    if histr = '' then histr = '3K'
  488.    else histr = histr||' 3K'
  489.    end
  490.   end
  491.                /* Chk for 4K */
  492.  do l = 1 to 6
  493.   if countin(dstring,l) > 3 & s.4K = '' then do
  494.    if histr = '' then histr = '4K'
  495.    else histr = histr||' 4K'
  496.    end
  497.   end
  498.                /* chk for FH */
  499.  do l = 1 to 6
  500.   if countin(dstring,l) > 2 then
  501.    do m = 1 to 6
  502.     if m = l then iterate m
  503.     if countin(dstring,m) > 1 & s.FH = '' then do
  504.      if histr = '' then histr = 'FH'
  505.      else histr = histr||' FH'
  506.      end
  507.     end
  508.   end
  509.                /* Chk for SS */
  510.  test = 0
  511.  test1 = 0
  512.  skip = 0
  513.  if s.SS = '' then do z = 1 to 3
  514.   if instring(az+z,dstring) then test = test + 1
  515.   skip = 1
  516.   end
  517.  if test < 3 then skip = 0
  518.  if s.SS = '' & skip = 0 then do z = 1 to 3
  519.   if instring(ez-z,dstring) then test1 = test1 + 1
  520.   end
  521.  if test = 3 | test1 = 3 then do
  522.   histr = histr||' SS'
  523.   end
  524.  
  525.                /* Chk for LS */
  526.  test = 0
  527.  test1 = 0
  528.  skip = 0
  529.  if s.LS = '' then do z = 1 to 4
  530.   if instring(az+z,dstring) then test = test + 1
  531.   skip = 1
  532.   end
  533.  if test < 4 then skip = 0
  534.  if s.LS = '' & skip = 0 then do z = 1 to 4
  535.   if instring(ez-z,dstring) then test1 = test1 + 1
  536.   end
  537.  if test = 4 | test1 = 4 then do
  538.   histr = histr||' LS'
  539.   end
  540.  
  541.                /* Chance is automatic unless already taken */
  542.  if s.c = '' then histr = histr||' C'
  543.                /* Chk fo Yacht_C */
  544.  do i = 1 to 6
  545.   if countin(dstring,i) = 5 & s.Y = '' then do
  546.    histr = histr||' Y'
  547.    end
  548.   end
  549.  
  550.  call sethi(histr)
  551. return
  552.  
  553. sethi:
  554.  arg histr
  555.  if histr = '' then do
  556.   call setalllow
  557.   optln = 'H Q P SC'
  558.   optln = center(optln,30)
  559.   call clrl(2)
  560.   say''poptln''bak.6''pen.1''optln''def''
  561.   return
  562.   end
  563.  call setalllow
  564.  optln = 'H Q P SC'
  565.  do i = 1 to words(histr)
  566.   hiword = word(histr,i)
  567.   do j = 1 to words(optstr)
  568.    optword = word(optstr,j)
  569.    where = pln.hiword
  570.    what = ln.hiword
  571.    if hiword = optword then do
  572.     say''where''hi''what''def''
  573.     optln = optln' 'hiword
  574.     iterate i
  575.     end
  576.    else say''where''low''what''def''
  577.    end
  578.   end
  579.  optln = center(optln,30)
  580.  call clrl(2)
  581.  say''poptln''bak.6''pen.1''optln''def''
  582. return
  583.  
  584. setalllow:
  585.  low = bak.0||pen.1
  586.  hi = bak.2||pen.1
  587.  say''pln.1''low''ln.1''def''
  588.  say''pln.2''low''ln.2''def''
  589.  say''pln.3''low''ln.3''def''
  590.  say''pln.4''low''ln.4''def''
  591.  say''pln.5''low''ln.5''def''
  592.  say''pln.6''low''ln.6''def''
  593.  say''pln.3K''low''ln.3K''def''
  594.  say''pln.4K''low''ln.4K''def''
  595.  say''pln.FH''low''ln.FH''def''
  596.  say''pln.SS''low''ln.SS''def''
  597.  say''pln.LS''low''ln.LS''def''
  598.  say''pln.c''low''ln.c''def''
  599.  if s.y = '50' then say''pln.y''low' [ Y] 'unl'Yacht-C        (50)'def''unl''pen.1' |'def''unl' 50'def''
  600.  if s.y = '' then say''pln.y''low' [ Y] 'unl'Yacht-C        (50)'def''unl''pen.1' |   'def''
  601.  if s.y = ' --' then say''pln.y''low' [ Y] 'unl'Yacht-C        (50)'def''unl''pen.1' |'def''unl' --'def''
  602. return
  603.  
  604. CountIn: procedure
  605. arg str,dnum
  606.    points = 0
  607.    pos = 1
  608.    oldpos = 1
  609.    do while (pos ~== 0)
  610.       pos = index(str,dnum,oldpos)
  611.       if (pos ~==0) then do
  612.          points = points + 1
  613.          oldpos = pos + 1
  614.       end
  615.    end
  616. return(points)
  617.  
  618.  
  619. holddice:
  620. pick = ''
  621.  call clrl(0)
  622.  call clrl(1)
  623.  prompt(''pprompt'Hold which dice ? (0-5) > ')
  624.  holdem=readstr()
  625.  holdem = strip(holdem)
  626.  if holdem = '' then call getopt
  627.  if holdem = '0' then do
  628.   pick = '12345'
  629.   return
  630.   end
  631.  do t = 1 to 5
  632.   if instring(t,holdem) then hold.t = ''pen.5'HOLD'def''
  633.   else do
  634.    hold.t = '    '
  635.    if pick = '' then pick = t
  636.    else pick = pick||t
  637.    end
  638.   end
  639.  do s = 1 to 5
  640.   say''phold.s''hold.s''
  641.   end
  642.  call clrl(0)
  643.  prompt(''pprompt'Look right to you ? (Y,n) > ')
  644.  answer=readstr()
  645.  if answer = 'N' then call holddice
  646. return
  647.  
  648. instring: procedure
  649. arg letter,string
  650.  if (index(string,letter) == 0) then return 0
  651.   else return 1
  652.  
  653. rolldice:
  654.  arg toroll
  655.  do i=1 to length(toroll)
  656.   die = substr(toroll,i,1)
  657.   if rvalue = 0 then do
  658.    dvalue.die = getrandom()
  659.    rvalue = 1
  660.    end
  661.   else do
  662.    dvalue.die = random(1,6)
  663.    rvalue = 0
  664.    end
  665.   do
  666.    do w = 1 to 6
  667.     say''pd.die.w''pen.2''bak.1' 'def''
  668.     end
  669.    do w = 7 to 9
  670.     say''pd.die.w''pen.2''bak.1''unl' 'def''
  671.     end
  672.    end
  673.  
  674.   if dvalue.die = 1 then pd.die.1.v = ' '
  675.   else pd.die.1.v = 'O'
  676.   pd.die.2.v = ' '
  677.   if dvalue.die > 3 then pd.die.3.v = 'O'
  678.   else pd.die.3.v = ' '
  679.   if dvalue.die = 6 then pd.die.4.v = 'O'
  680.   else pd.die.4.v = ' '
  681.   if dvalue.die = 1 | dvalue.die = 3 | dvalue.die = 5 then pd.die.5.v = 'O'
  682.   else pd.die.5.v = ' '
  683.   if dvalue.die = 6 then pd.die.6.v = 'O'
  684.   else pd.die.6.v = ' '
  685.   if dvalue.die > 3 then pd.die.7.v = ''unl'O'
  686.   else pd.die.7.v = ''unl' '
  687.   pd.die.8.v = ''unl' '
  688.   if dvalue.die > 1 then pd.die.9.v = ''unl'O'
  689.   else pd.die.9.v = ''unl' '
  690.   do x = 1 to 9
  691.    if pd.die.x.v = ' ' then say''pd.die.x''pen.2''bak.1' 'def''
  692.    else say''pd.die.x''pen.2''bak.1''pd.die.x.v''def''
  693.    end
  694.  
  695.   end
  696.  rollsleft = rollsleft - 1
  697. call getopt
  698. exit
  699.  
  700. Help:
  701.  say''CLS''
  702.  say cr
  703.  say'    'pen.7'Yacht_C written by Matt English 7-29-93'def''cr
  704.  say cr
  705.  say'  Yacht_C is a fairly simple (and fun) dice game!'cr
  706.  say' The object is to fill your score card with all'cr
  707.  say' the options and achieve the highest possible score!'cr
  708.  say cr
  709.  say'  You get up to 3 rolls of the 5 dice for each turn.'cr
  710.  say' To roll the dice, just hit 'pen.3'RETURN'def' at the prompt,'cr
  711.  say' and you''ll be asked which dice you''d like to hold. Enter the'cr
  712.  say' numbers that appear over the dice you wanna hold, (1-5).'cr
  713.  say' After your first roll, you can 'pen.2'HOLD'def' any of the dice'cr
  714.  say' and re-roll the remaining dice. You don''t have to hold'cr
  715.  say' any dice if you wanna re-roll all of them.'cr
  716.  say cr
  717.  say'  You 'pen.3'MUST'def' score one item on your score card each turn!'cr
  718.  say' If there aren''t any available options, you 'pen.3'MUST SCRATCH'def''cr
  719.  say' one item. You will receive zero points for each scratched'cr
  720.  say' item, so try to avoid it..'cr
  721.  say cr
  722.  prompt(' 'pen.4'Hit return to continue...'def'')
  723.  junk=readstr()
  724.  say''cls''
  725.  say cr
  726.  say' 'pen.6'The Options:'def''cr
  727.  say cr
  728.  say' 1''s thru 6''s........ Add the total of all the matching dice.'cr
  729.  say' 3K (3 of a kind).... At least 3 dice match, Add all dice.'cr
  730.  say' 4K (4 of a kins).... At least 4 dice match, Add all dice.'cr
  731.  say' FH (Full House)..... 3 dice match AND 2 other dice match'cr
  732.  Say' SS (Small Straight). Run of 4 dice (1,2,3,4) (3,4,5,6)'cr
  733.  say' LS (Large Straight). Run of 5 dice (1,2,3,4,5) (2,3,4,5,6)'cr
  734.  say' C  (Chance)......... Take this when there are no other choices.'cr
  735.  say' Y  (Yacht_C)........ All five dice match.'cr
  736.  say cr
  737.  say' 'pen.5'BONUS!'def''cr
  738.  say cr
  739.  say'  If you can achieve a score of 63 or more on the upper part'cr
  740.  say' of the score sheet, you get a 35 point Bonus!'cr
  741.  say cr
  742.  prompt(' 'pen.4'Hit return to continue...'def'')
  743.  junk=readstr()
  744.  say''cls''
  745.  say cr
  746.  say' 'pen.5'Prefs:'def''cr
  747.  say cr
  748.  say'  Using Prefs will give you 6 options to adjust the colors'cr
  749.  say' that you see while playing this game. Your choice will be'cr
  750.  say' recorded and used each time you play the game. You can change'cr
  751.  say' it at any time.'cr
  752.  say cr
  753.  say'  If at any time your screen gets screwed up (phone noise,'cr
  754.  say' crazy fingers, ect..) Just re-read this help file, or go to'cr
  755.  say' the prefs utility and your screen will be re-drawn when you'cr
  756.  say' return to the game.'cr
  757.  say cr
  758.  say'  Your score will be automatically saved when you quit the game'cr
  759.  say' so that you can continue your game next call if you wish.'cr
  760.  say cr
  761.  say' 'pen.7'Hope you enjoy the game!'def''cr
  762.  say cr
  763.  prompt(' 'pen.4'Hit return to continue...'def'')
  764.  junk=readstr()
  765.  call refresh1
  766.  call refresh2
  767.  call showdice
  768.  call getopt
  769. return
  770.  
  771. setPrefs:
  772.  say''cls''cr
  773.  say cr
  774.  say cr
  775.  say' Since everyone has their color palettes set'cr
  776.  say' differently on their Comm programs, there is no'cr
  777.  say' way to tell how the colors for this game will'cr
  778.  say' look on your screen.'cr
  779.  say cr
  780.  say' This little utility will set and save your'cr
  781.  say' colors preferences for this game. You can 'cr
  782.  say' change them again at any time.'cr
  783.  say cr
  784.  say' ColorSet # 1       ColorSet # 2       ColorSet # 3'cr
  785.  say' ColorSet # 4       ColorSet # 5       ColorSet # 6'cr
  786.  say cr
  787.  prompt(' Enter a ColorSet # to use (1-6) > ')
  788.  color=readstr()
  789.  if color = '' then do
  790.   call refresh1
  791.   call refresh2
  792.   call setlines
  793.   call showdice
  794.   call getopt
  795.   end
  796.  if ~datatype(color,'W') then call setprefs
  797.  if color < 0 | color > 6 then call setprefs
  798.  call prefs(color)
  799.  say cr
  800.  prompt(' Enter "T" to test or RETURN to use > ')
  801.  test=readstr()
  802.  if test = 'T' then do
  803.   call refresh1
  804.   call refresh2
  805.   call setlines
  806.   prompt(''pprompt'Hit Return to continue')
  807.   junk=readstr()
  808.   call setprefs
  809.   end
  810.  else do
  811.   call refresh1
  812.   call refresh2
  813.   call setlines
  814.   call showdice
  815.   call getopt
  816.   end
  817.  
  818.  
  819. Prefs:
  820.  arg colorset
  821.  if colorset = '' then colorset = 1
  822.  col.0=''
  823.  col.1=''
  824.  col.2=''
  825.  col.3=''
  826.  col.4=''
  827.  col.5=''
  828.  col.6=''
  829.  col.7=''
  830.  bakcol.0=''
  831.  bakcol.1=''
  832.  bakcol.2=''
  833.  bakcol.3=''
  834.  bakcol.4=''
  835.  bakcol.5=''
  836.  bakcol.6=''
  837.  bakcol.7=''
  838.  if colorset = 1 then do
  839.   do i = 0 to 7
  840.    pen.i = col.i
  841.    end
  842.   do i = 0 to 7
  843.    bak.i = bakcol.i
  844.    end
  845.   end
  846.  if colorset = 2 then do
  847.   do i = 1 to 7
  848.    if i = 7 then do
  849.     pen.i = col.1
  850.     iterate i
  851.     end
  852.    x = i + 1
  853.    pen.i = col.x
  854.    end
  855.   do i = 1 to 7
  856.    if i = 7 then do
  857.     bak.i = bakcol.1
  858.     iterate i
  859.     end
  860.    x = i + 1
  861.    bak.i = bakcol.x
  862.    end
  863.   end
  864.  if colorset = 3 then do
  865.  j = 0
  866.  k = 0
  867.   do i = 1 to 7
  868.    if i > 5 then do
  869.     j = j + 1
  870.     pen.i = col.j
  871.     iterate i
  872.     end
  873.    x = i + 2
  874.    pen.i = col.x
  875.    end
  876.   do i = 1 to 7
  877.    if i > 5 then do
  878.     k = k + 1
  879.     bak.i = bakcol.k
  880.     iterate i
  881.     end
  882.    x = i + 2
  883.    bak.i = bakcol.x
  884.    end
  885.   end
  886.  if colorset = 4 then do
  887.  j = 0
  888.  k = 0
  889.   do i = 1 to 7
  890.    if i > 4 then do
  891.     j = j + 1
  892.     pen.i = col.j
  893.     iterate i
  894.     end
  895.    x = I + 3
  896.    pen.i = col.x
  897.    end
  898.   do i = 1 to 7
  899.    if i > 4 then do
  900.     k = k + 1
  901.     bak.i = bakcol.k
  902.     iterate i
  903.     end
  904.    x = i + 3
  905.    bak.i = bakcol.x
  906.    end
  907.   end
  908.  if colorset = 5 then do
  909.  j = 0
  910.  k = 0
  911.   do i = 1 to 7
  912.    if i > 3 then do
  913.     j = j + 1
  914.     pen.i = col.j
  915.     iterate i
  916.     end
  917.    x = i + 4
  918.    pen.i = col.x
  919.    end
  920.   do i = 1 to 7
  921.    if i > 3 then do
  922.     k = k + 1
  923.     bak.i = bakcol.k
  924.     iterate i
  925.     end
  926.    x = i + 4
  927.    bak.i = bakcol.x
  928.    end
  929.   end
  930.  if colorset = 6 then do
  931.  j = 0
  932.  k = 0
  933.   do i = 1 to 7
  934.    if i > 2 then do
  935.     j = j + 1
  936.     pen.i = col.j
  937.     iterate i
  938.     end
  939.    x = i + 5
  940.    pen.i = col.x
  941.    end
  942.   do i = 1 to 7
  943.    if i > 2 then do
  944.     k = k + 1
  945.     bak.i = bakcol.k
  946.     iterate i
  947.     end
  948.    x = i + 5
  949.    bak.i = bakcol.x
  950.    end
  951.   end
  952.  
  953. return
  954.  
  955. getrandom:
  956.  call sortstr2
  957.  x = random(1,4)
  958.  if x = 1 then it = caz
  959.  if x = 2 then it = cbz
  960.  if x = 3 then it = ccz
  961.  if x = 4 then it = cdz
  962.  do
  963.   count = word(it,1)
  964.   num = word(it,2)
  965.   do ii = 1 to 6
  966.    testcount = word(dcstring,(ii*2)-1)
  967.    testnum = word(dcstring,ii*2)
  968.    if testnum = num then do
  969.     count = count + 1
  970.     if ii = 1 then tempstring = count' 'num
  971.     else tempstring = tempstring' 'count' 'num
  972.     end
  973.    else do
  974.     if ii = 1 then tempstring = testcount' 'testnum
  975.     else tempstring = tempstring' 'testcount' 'testnum
  976.     end
  977.    end
  978.   end
  979.   dcstring = tempstring
  980. return right(num,1)
  981.  
  982. sortstr2:
  983.  call open(file,'ram:sortfile2','W')
  984.  do ii = 1 to 6
  985.   num = word(dcstring,ii*2)
  986.   count = word(dcstring,(ii*2)-1)
  987.   call writeln(file,count num)
  988.   end
  989.  call close(file)
  990.  address command'sort Ram:sortfile2 ram:sorted2 NUMERIC'
  991.  call open(file,'ram:sorted2','R')
  992.  caz=readln(file)
  993.  cbz=Readln(file)
  994.  ccz=readln(file)
  995.  cdz=readln(file)
  996.  cez=readln(file)
  997.  cfz=readln(file)
  998.  call close(file)
  999. return
  1000.  
  1001. showdice:
  1002.  do die = 1 to 5
  1003.   if dvalue.die = 1 then pd.die.1.v = ' '
  1004.   else pd.die.1.v = 'O'
  1005.   pd.die.2.v = ' '
  1006.   if dvalue.die > 3 then pd.die.3.v = 'O'
  1007.   else pd.die.3.v = ' '
  1008.   if dvalue.die = 6 then pd.die.4.v = 'O'
  1009.   else pd.die.4.v = ' '
  1010.   if dvalue.die = 1 | dvalue.die = 3 | dvalue.die = 5 then pd.die.5.v = 'O'
  1011.   else pd.die.5.v = ' '
  1012.   if dvalue.die = 6 then pd.die.6.v = 'O'
  1013.   else pd.die.6.v = ' '
  1014.   if dvalue.die > 3 then pd.die.7.v = ''unl'O'
  1015.   else pd.die.7.v = ''unl' '
  1016.   pd.die.8.v = ''unl' '
  1017.   if dvalue.die > 1 then pd.die.9.v = ''unl'O'
  1018.   else pd.die.9.v = ''unl' '
  1019.   do x = 1 to 9
  1020.    if pd.die.x.v = ' ' then say''pd.die.x''pen.2''bak.1' 'def''
  1021.    else say''pd.die.x''pen.2''bak.1''pd.die.x.v''def''
  1022.    end
  1023.   end
  1024. return
  1025.  
  1026. refresh1:
  1027. low = bak.0||pen.1
  1028. hi = bak.2||pen.1
  1029. say''def''cls''cr
  1030. say''pen.1'      'unl'                    |   'def'    'pen.1''bak.5'Yacht_C 1.1 by Matt English'def''cr
  1031. say''pen.1' [ 1] ones      (add 1''s) |'def'       'cr
  1032. say''pen.1' [ 2] twos      (add 2''s) |   'def'   'unl''pen.2'  1  'def' 'unl''pen.2'  2  'def' 'unl''pen.2'  3  'def' 'unl''pen.2'  4  'def' 'unl''pen.2'  5  'def''cr
  1033. say''pen.1' [ 3] threes    (add 3''s) |      'bak.1''pen.2'|   |'def' 'bak.1''pen.2'|O  |'def' 'bak.1''pen.2'|O  |'def' 'bak.1''pen.2'|O O|'def' 'bak.1''pen.2'|O O|'def''cr
  1034. say''pen.1' [ 4] fours     (add 4''s) |      'bak.1''pen.2'| O |'def' 'bak.1''pen.2'|   |'def' 'bak.1''pen.2'| O |'def' 'bak.1''pen.2'|   |'def' 'bak.1''pen.2'| O |'def' 'cr
  1035. say''pen.1' [ 5] fives     (add 5''s) |      'unl''bak.1''pen.2'|   |'def' 'unl''bak.1''pen.2'|  O|'def' 'unl''bak.1''pen.2'|  O|'def' 'unl''bak.1''pen.2'|O O|'def' 'unl''bak.1''pen.2'|O O|'def'   'cr
  1036. say''pen.1' [ 6] 'unl'sixes     (add 6''s) |   'def'    'cr
  1037. say''pen.1'            Sub TOTAL     |  'def'             'cr
  1038. say''pen.1'            'unl'BONUS         |   'def'   'pen.3' "H" = Help'def'   'pen.3' "P" = Prefs'def''cr
  1039. say''pen.1'            Upper TOTAL   |      'pen.3' "Q" = Quit'def'   'pen.3'"SC" = Scratch'def''cr
  1040. say'                                              'cr
  1041. say''pen.1' [3K] 3 of a kind (total) | 'def''cr
  1042. say''pen.1' [4K] 4 of a kind (total) |      'bak.6'          'unl'Options :'def''bak.6'           'def''cr
  1043. say''pen.1' [FH] Full House     (25) |      'bak.6'                              'def' 'cr
  1044. say''pen.1' [SS] Small Straight (30) |      'bak.6'                              'def' 'cr
  1045. say''pen.1' [LS] Large Straight (40) | 'def''cr
  1046. say''pen.1' [ C] Chance      (total) | 'def''cr
  1047. say''pen.1' [ Y] 'unl'Yacht-C        (50) |   'def'        'cr
  1048. say''pen.1'            Lower TOTAL   | 'def''cr
  1049. say''pen.1'            'unl'Upper TOTAL   |   'def''cr
  1050. say''pen.1'            Game TOTAL    | 'def''cr
  1051. return
  1052.  
  1053. refresh2:
  1054. say''pplayer''player''
  1055. say''ps.1''right(s.1,3)''
  1056. say''ps.2''right(s.2,3)''
  1057. say''ps.3''right(s.3,3)''
  1058. say''ps.4''right(s.4,3)''
  1059. say''ps.5''right(s.5,3)''
  1060. say''ps.6''unl''right(s.6,3)''def''
  1061. say''psub''right(sub,3)''
  1062. say''pbon''unl''right(bon,3)''def''
  1063. say''putot''right(utot,3)''
  1064. say''ps.3k''right(s.3k,3)''
  1065. say''ps.4k''right(s.4k,3)''
  1066. say''ps.fh''right(s.fh,3)''
  1067. say''ps.ss''right(s.ss,3)''
  1068. say''ps.ls''right(s.ls,3)''
  1069. say''ps.c''right(s.c,3)''
  1070. say''ps.y''unl''right(s.y,3)''def''
  1071. say''pltot''right(ltot,3)''
  1072. say''putot2''unl''right(utot2,3)''def''
  1073. say''ptot''right(tot,3)''
  1074. say''phold.1''hold.1''
  1075. say''phold.2''hold.2''
  1076. say''phold.3''hold.3''
  1077. say''phold.4''hold.4''
  1078. say''phold.5''hold.5''
  1079. say''prollsleft''pen.1''rollsleft' 'pen.4'Rolls left this turn'def''
  1080. return
  1081.  
  1082. savescore:
  1083.  if ~exists(datapath'/scores') then do
  1084.   call open(win,datapath'/scores','W')
  1085.   call writeln(win,'100 MATT_ENGLISH 'date())
  1086.   call close(win)
  1087.   end
  1088.  if newplayer = 1 then do
  1089.   call open(win,datapath'/scores','A')
  1090.   call writeln(win,tot name date())
  1091.   call close(win)
  1092.   call sortscore
  1093.   call checkplace(1)
  1094.   call clrl(0)
  1095.   call clrl(1)
  1096.   fromtop = (scorecount - yspos) + 1
  1097.   call getpost
  1098.   say''pprompt'This game''s score was 'fromtop''post''
  1099.   say''pprompt1'  place outta 'scorecount' players!'
  1100.   call delay(250)
  1101.   end
  1102.  if newplayer = 0 then do
  1103.   call checkplace(1)
  1104.   if tot > oldtop then do
  1105.    call open(win,datapath'/scores','W')
  1106.    do i = 1 to scorecount
  1107.     call writeln(win,bestln.i)
  1108.     end
  1109.    call close(win)
  1110.    call sortscore
  1111.    call checkplace(2)
  1112.    call clrl(0)
  1113.    call clrl(1)
  1114.    say''pprompt'This score beats your previous'
  1115.    say''pprompt1'best of 'oldtop' from 'olddate2' 'olddate1' 'olddate3' !'
  1116.    fromtop = (scorecount - yspos) + 1
  1117.    call getpost
  1118.    say''pprompt2''fromtop''post' place outta 'scorecount' players!'
  1119.    call delay(250)
  1120.    call clrl(3)
  1121.    end
  1122.   else do
  1123.    call clrl(0)
  1124.    call clrl(1)
  1125.    say''pprompt'This didn''t beat your previous'
  1126.    say''pprompt1'best of 'ytopscore' from 'ytopdate2' 'ytopdate1' 'ytopdate3'..'
  1127.    fromtop = (scorecount - yspos) + 1
  1128.    call getpost
  1129.    say''pprompt2''fromtop''post' place outta 'scorecount' players!'
  1130.    call delay(250)
  1131.    call clrl(3)
  1132.    end
  1133.   end
  1134. return
  1135.  
  1136. getpost:
  1137.  if right(fromtop,2) > 10 & right(fromtop,2) < 14 then post = 'th'
  1138.  else do
  1139.   if right(fromtop,1) = 0 | right(fromtop,1) > 3 & right(fromtop,1) < 10 then post = 'th'
  1140.   if right(fromtop,1) = 1 then post = 'st'
  1141.   if right(fromtop,1) = 2 then post = 'nd'
  1142.   if right(fromtop,1) = 3 then post = 'rd'
  1143.   end
  1144. return
  1145.  
  1146. sortscore:
  1147.  address command'sort 'datapath'/scores Ram:sortscores numeric'
  1148.  address command'C:copy Ram:sortscores 'datapath'/scores QUIET'
  1149.  call delete('RAM:sortscores')
  1150. return
  1151.  
  1152. checkplace:
  1153.  arg times
  1154.  scorecount = 0
  1155.  call open(win,datapath'/scores','r')
  1156.  do until eof(win)
  1157.   scorecount = scorecount + 1
  1158.   bestln.scorecount = readln(win)
  1159.   if bestln.scorecount = '' then do
  1160.    scorecount = scorecount - 1
  1161.    break
  1162.    end
  1163.   if times ~= '3' & word(bestln.scorecount,2) = name then do
  1164.    yspos = scorecount                                  /* your score pos from bottom of list */
  1165.    ytopscore = word(bestln.scorecount,1)                              /* your top score */
  1166.    ytopdate1 = word(bestln.scorecount,3)                               /* the date you got the top score */
  1167.    ytopdate2 = word(bestln.scorecount,4)
  1168.    ytopdate3 = word(bestln.scorecount,5)
  1169.    if times = '1' & tot > ytopscore then do
  1170.     bestln.scorecount = tot name date()
  1171.     oldtop = ytopscore
  1172.     olddate1 = ytopdate1
  1173.     olddate2 = ytopdate2
  1174.     olddate3 = ytopdate3
  1175.     end
  1176.    end
  1177.   end
  1178.  call close(win)
  1179. return
  1180.  
  1181.  
  1182. done:
  1183.  call clrl(0)
  1184.  call clrl(1)
  1185.  say''pprompt'Checking your score against'
  1186.  say''pprompt1'the High Score list..'
  1187.  call delay(100)
  1188.  call savescore
  1189.  call clrl(0)
  1190.  call clrl(1)
  1191.  prompt(''pprompt'Wanna play again? (Y,n) > ')
  1192.  playagain=readstr()
  1193.  call zerovar
  1194.  if newplayer = 1 then call savedata
  1195.  newplayer = 0
  1196.  if playagain = 'N' then call quit(2)
  1197.  call refresh1
  1198.  call refresh2
  1199.  call setlines
  1200. /* call loop */
  1201.  call getopt
  1202.  end
  1203.  
  1204. quit:
  1205.  arg quitopt
  1206.  call clrl(0)
  1207.  call clrl(1)
  1208.  if quitopt ~= 2 then do
  1209.   prompt(''pprompt'Really Quit? (Y,n) > ')
  1210.   this=readstr()
  1211.   if this = 'N' then call getopt
  1212.   end
  1213. call savedata
  1214. exit
  1215.  
  1216. readstr: procedure
  1217. str=''
  1218. out=readch(STDIN)
  1219.  call WRITECH(STDOUT,out)
  1220.  do while out~=D2C(13)
  1221.       if out=D2C(8) then do
  1222.          str=SUBSTR(str,1,LENGTH(str)-1)
  1223.          call WRITECH(STDOUT,' ')
  1224.          call WRITECH(STDOUT,out)
  1225.          end
  1226.       else
  1227.          str=INSERT(str,out)
  1228.       out=readch(STDIN)
  1229.       call WRITECH(STDOUT,out)
  1230.     end
  1231. say '0D'x
  1232. return(UPPER(str))
  1233.  
  1234. prompt: procedure
  1235. parse arg str
  1236. writech(STDOUT,str)
  1237. return 1
  1238.  
  1239. Break_C:
  1240. Break_E:
  1241.  call clrl(0)
  1242.  say''pprompt'Saving data, standby ....'
  1243.  call savedata
  1244.  if quitopt ~= 2 then call savescore
  1245.  if exists('ram:sortfile') then call delete('ram:sortfile')
  1246.  if exists('ram:sortfile2') then call delete('ram:sortfile2')
  1247.  if exists('ram:sorted') then call delete('ram:sorted')
  1248.  if exists('ram:sorted2') then call delete('ram:sorted2')
  1249.  call clrl(0)
  1250.  call clrl(1)
  1251.  call clrl(3)
  1252.  say''pprompt'Thanks for playing Yacht_C!'
  1253.  call delay(100)
  1254.  call checkplace(3)
  1255.  say''CLS''cr
  1256.  title = 'Top 15 Yacht_C Players!!!'
  1257.  title = center(title,70)
  1258.  say''pen.3''title''def''cr
  1259.  say cr
  1260.  line = bestln.scorecount
  1261.  score = left(word(line,1),5)
  1262.  name = left(word(line,2),20)
  1263.  date1 = left(word(line,4),4)
  1264.  date2 = left(word(line,3),3)
  1265.  yr = word(line,5)
  1266.  say'                 'pen.6''score''name''date1''date2''yr''def''cr
  1267.  do i = 1 to 14
  1268.   scorecount = scorecount - 1
  1269.   if scorecount = 0 then leave i
  1270.   line = bestln.scorecount
  1271.   score = left(word(line,1),5)
  1272.   name = left(word(line,2),20)
  1273.   date1 = left(word(line,4),4)
  1274.   date2 = left(word(line,3),3)
  1275.   yr = word(line,5)
  1276.   say'                 'pen.6''score''name''date1''date2''yr''def''cr
  1277.   end
  1278.  call delay(250)
  1279.  say cr
  1280.  say'   Bye!'cr
  1281.  exit
  1282.  
  1283. checkBBS:
  1284. IF ADDRESS()~='BAUD' THEN RETURN 0
  1285. IF TIME('E')>secs THEN SIGNAL BREAK_C
  1286. dcd
  1287. IF RC=0 THEN SIGNAL BREAK_C
  1288. temp=secs-TIME('E')
  1289. IF temp<120 THEN SAY '*** Only' temp 'seconds left! ***'CR
  1290. RETURN 0
  1291.